perm filename PLT.F4[1,LCS] blob sn#577303 filedate 1981-04-10 generic text, type T, neo UTF8
C>BM=66 LM=1 TM=1 J=N    
      DIMENSION NN(3,500),MM(100)  
C     REAL*8 BLANK,VENUS,NAME 
C     INTEGER*1 NA,ISTAR,MM,IBLA   
      DATA ID/21/,IBLA/' '/,ISTAR/42/,BLANK/' '/,VENUS/'V'/ 
89    FORMAT(' TYPE FILE NAME ')   
      WRITE(5,89)   
91    FORMAT(A5)    
92    FORMAT(1XA5)  
      READ(5,91)NAME
      WRITE(5,92)NAME    
C     IF(NAME.EQ.BLANK)NAME=VENUS  
      WRITE(5,93)   
      READ(5,1)JWIDTH    
      IF(JWIDTH.LT.80)JWIDTH=80    
      IF(JWIDTH.GT.100)JWIDTH=100  
93    FORMAT(' TYPE NUMBER OF CHARACTERS/LINE ')  
94    FORMAT(' TYPE "Y" SIZE FACTOR. (0=1) ')
95    FORMAT(1F6.3) 
      WRITE(5,94)   
      READ(5,95)YSIZE    
      IF(YSIZE.LT.0.2)YSIZE=1.0    
      WRITE(5,95)YSIZE   
C     CALL OPEN(1,NAME,256)   
	CALL IFILE(1,NAME)
C     WRITE(5,88)   
C     READ(5,1)ISTAR
C     WRITE(5,30)ISTAR   
	ISTAR='*'
96    FORMAT(' TYPE HORIZONTAL DISPLACEMENT ')    
      WRITE(5,96)   
      READ(5,1)JDIS 
88    FORMAT(' TYPE CHARACTER NUMBER ') 
1     FORMAT(3I)   
30    FORMAT(1X,3I4)
      N=0 
      KK=1
100   READ(1,1,END=90)I,J,K   
      IF(I.LT.0)GO TO 90 
C -1 ENDS INPUT
      NN(1,KK)=I+JDIS    
      NN(3,KK)=K    
      A=J*YSIZE
      J=A 
      IF(N.LT.J)N=J 
      NN(2,KK)=J    
      KK=KK+1  
      GO TO 100
90    DO 7 K=1,JWIDTH    
7     MM(K)=IBLA    
12    LL=1
      KA=1
2     K=NN(1,LL)    
      L=NN(2,LL)    
      M=NN(3,LL)    
      IF(M.LT.0)GO TO 80 
9     IF(M.EQ.0)GO TO 3  
5     I=K 
      J=L 
C  SAVE PREVIOUS POINT   
      GO TO 80 
10    I=1 
      IF(NN(3,LL+1).NE.0)I=-I 
      NN(3,LL)=I    
C MARK SEGS ENTIRELY ABOVE CURRENT LINE.
      GO TO 5  
3     IF(L.LT.N.AND.J.LT.N)GO TO 5 
      IF(L.GT.N.AND.J.GT.N)GO TO 10
C JUMP IF BOTH Y COORDS ARE LOWER THAN THIS LINE. 
8     X=K-I    
      IF(X.NE.0)GO TO 13 
      M=K 
C VERTICAL LINE
      IF(M.GT.JWIDTH)GO TO 5  
      GO TO 14 
13    Y=L-J    
      IF(Y.NE.0)GO TO 15 
      IF(K.GT.I)GO TO 16 
      JA=K
      JB=I
      GO TO 17 
16    JA=I
      JB=K
17    IF(JB.GT.JWIDTH)JB=JWIDTH    
      IF(JA.GT.JWIDTH)JA=JWIDTH    
      DO 18 M=JA,JB 
18    MM(M)=ISTAR   
C HORIZONTAL LINE   
      NN(3,LL)=1    
      M=JB
      GO TO 19 
C LENGTHS OF X AND Y SEGMENTS 
15    IF(K.LT.I)GO TO 40 
      JK=K
      JI=I
      JJ=J
      JL=L
      GO TO 41 
40    JK=I
      JI=K
      JJ=L
      JL=J
      JJ=L
41    X=JK-JI  
      Y=JL-JJ  
      UU=JI+.5 
      A=N-JJ   
      U=JJ+.5  
      H=Y/X    
      NA=0
      DO 42 JC=JI,JK
      V=JC-JI  
      LA=H*V+U 
      IF(LA.LT.N)GO TO 43
      IF(LA.EQ.N)GO TO 45
      IF(NA.LT.0)GO TO 44
      NA=1
      GO TO 42 
43    IF(NA.GT.0)GO TO 44
      NA=-1    
      GO TO 42 
44    B=A/H+UU 
      M=B 
      GO TO 46 
45    M=JC
46    NA=0
      IF(M.GT.JWIDTH)GO TO 42 
      MM(M)=ISTAR   
      IF(M.GT.KA)KA=M    
42    CONTINUE 
      GO TO 5  
14    MM(M)=ISTAR   
C SOLID GRAPHICS CHAR.   
19    IF(M.GT.KA)KA=M    
      IF(KA.GT.JWIDTH)KA=JWIDTH    
      GO TO 5  
80    LL=LL+1  
      IF(LL.LT.KK)GO TO 2
C GO BACK AND LOOK AT MORE VECTORS 
C     WRITE(5,20)(MM(K),K=1,KA)    
      WRITE(ID,20)(MM(K),K=1,KA)    
      N=N-1    
      IF(N.GE.0)GO TO 90 
      WRITE(ID,20)IBLA    
C SO LAST REAL LINE WILL PRINT
20    FORMAT(1X,100A1)   
      END